home *** CD-ROM | disk | FTP | other *** search
/ Compendium Deluxe 2 / LSD and 17bit Compendium Deluxe - Volume II.iso / a / prog / amigae / stderr.lha / stderr.e < prev    next >
Encoding:
Text File  |  1994-09-06  |  3.3 KB  |  152 lines
  1. -> StdErr.E
  2. -> The flexible stderr port for Amiga E
  3.  
  4. OPT MODULE
  5.  
  6. MODULE 'dos/datetime','dos/dos'
  7.  
  8. -> Recommended tests to make:
  9.  
  10. RAISE "OPEN" IF Open() = NIL,
  11.       "MEM"  IF New() = NIL,
  12.       "FILE" IF VfPrintf() = TRUE,
  13.       "FILE" IF Fputs() = TRUE
  14.  
  15. /*endfold*/
  16.  
  17. -> Global declarations (global to StdErr)
  18.  
  19. OBJECT err
  20. PRIVATE
  21.  filename,
  22.  private,
  23.  fh,
  24.  ioerr,
  25.  name
  26. ENDOBJECT
  27.  
  28. DEF stderr:PTR TO err
  29. /*endfold*/
  30.  
  31. PROC close()
  32.  IF stderr.fh AND (stderr.fh <> stdout) THEN Close(stderr.fh)
  33.  stderr.fh:=0
  34. ENDPROC
  35.  
  36. PROC open() HANDLE
  37.  DEF dt:datetime,tmp
  38.  stderr.ioerr:=SetIoErr(0)
  39.  IF stderr.filename <> stderr.private
  40.   close()
  41.   IF stderr.filename=stdout
  42.    stderr.fh:=stdout
  43.   ENDIF
  44.   stderr.private:=stderr.filename
  45.  ENDIF
  46.  IF stderr.private AND (stderr.private <> stdout)
  47.   DateStamp(dt.stamp)
  48.   dt.format:=FORMAT_DOS -> set datetime options
  49.   dt.flags:=0
  50.   dt.strday:=String(11)
  51.   dt.strdate:=String(11)
  52.   dt.strtime:=String(11)
  53.   DateToStr(dt)         -> make into string
  54.   IF (stderr.fh <> stdout) AND (stderr.fh = NIL)
  55.     IF tmp := Open(stderr.private,MODE_READWRITE)
  56.      stderr.fh := tmp
  57.     ELSE
  58.      stderr.fh := stdout
  59.     ENDIF
  60.   ENDIF
  61.   Seek(stderr.fh,0,OFFSET_END)
  62.   VfPrintf(stderr.fh,'\s: \s | \s | \s\n',[stderr.name,dt.strday,dt.strdate,dt.strtime])
  63.   Flush(stderr.fh)
  64.   Dispose(dt.strday); Dispose(dt.strdate); Dispose(dt.strtime)
  65.  ELSEIF wbmessage                 -> if called from icon
  66.   IF (stderr.fh <> stdout) AND stderr.fh THEN Close(stderr.fh)
  67.   WriteF('')
  68.   stderr.fh:=stdout
  69.   SetIoErr(0)
  70.  ELSEIF stderr.private <> stdout
  71.   IF (stderr.fh <> stdout) AND stderr.fh THEN Close(stderr.fh)
  72.   stderr.fh:=Open('CONSOLE:',NEWFILE) -> for stderr activity on CLI call
  73.  ENDIF
  74.  IF stderr.fh=0
  75.   stderr.fh:=stdout
  76.  ENDIF
  77.  
  78. EXCEPT
  79.  close()
  80.  stderr.ioerr:=SetIoErr(0)
  81.  WriteF('*** Error in stderr.open()')
  82.  IF stderr.ioerr THEN PrintFault(stderr.ioerr,stderr.name)
  83.  WriteF('\n')
  84.  Raise(exception)
  85. ENDPROC
  86.  
  87. EXPORT PROC err_Name(program_name=NIL) HANDLE
  88.  IF stderr=NIL
  89.   NEW stderr
  90.  ENDIF
  91.  IF program_name THEN stderr.name := program_name ELSE stderr.name := 'StdErr'
  92. EXCEPT
  93.  Raise(exception)
  94. ENDPROC
  95.  
  96. EXPORT PROC err_Dispose()
  97.  IF stderr=NIL THEN RETURN
  98.  close()
  99.  IF wbmessage AND stdout THEN WriteF('Press RETURN to close window.\b')
  100.  Dispose(stderr)
  101.  stderr:=NIL
  102. ENDPROC
  103.  
  104. EXPORT PROC err_WriteF(format=NIL,items=NIL) HANDLE
  105. -> Here's a way to write errors without having to open a window until we
  106. -> absolutely HAVE to.
  107.  DEF ioerr
  108.  IF stderr
  109.   open()
  110.  ELSE
  111.   NEW stderr
  112.   open()
  113.  ENDIF
  114.  IF items
  115.   VfPrintf(stderr.fh,format,items)
  116.   Flush(stderr.fh)
  117.  ELSE
  118.   IF format
  119.    Fputs(stderr.fh,format)
  120.    Flush(stderr.fh)
  121.   ENDIF
  122.  ENDIF
  123.  IF stderr.ioerr
  124.   ioerr:=String(81)
  125.   IF Fault(stderr.ioerr,stderr.name,ioerr,80)
  126.    Fputs(stderr.fh,ioerr)
  127.    Fputs(stderr.fh,'\n')
  128.    Flush(stderr.fh)
  129.   ENDIF
  130.  ENDIF
  131. EXCEPT
  132.  IF stderr=NIL THEN NEW stderr
  133.  ioerr:=SetIoErr(0)
  134.  WriteF('*** Error in err_WriteF()!')
  135.  IF ioerr THEN PrintFault(ioerr,'StdErr')
  136.  WriteF('\n')
  137.  Raise(exception)
  138. ENDPROC
  139.  
  140. EXPORT PROC err_New(filename=NIL) HANDLE
  141.  IF stderr=NIL THEN NEW stderr
  142.  close()
  143.  IF (stderr.filename<>0) AND (stderr.filename<>stdout) THEN Dispose(stderr.filename)
  144.  stderr.filename:=filename
  145.  IF stderr.name = NIL THEN stderr.name := 'StdErr'
  146. EXCEPT
  147.  Raise(exception)
  148. ENDPROC
  149. /*EE folds
  150. -1
  151. 8 7 12 7 10 5 12 2 15 48 18 6 21 5 24 33 27 7     EE folds*/
  152.